home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / ciarnv85.arc / H2.4TH < prev    next >
Text File  |  1986-04-08  |  18KB  |  413 lines
  1. HEX
  2. CTAG
  3.  
  4. ( If HEXR is ON, all data characters received by the HOST computer will be ) 
  5. ( displayed as 2 hex digits followed by 2 blanks. If DECR is ON each data  )
  6. ( byte is displayed as 3 decimal digits and 1 blank. If CHARR is ON then   )
  7. ( each byte will be displayed as printable character preceded by either a  )
  8. ( . if the hi bit is off, or a : if the hi bit is on. If it is not a print-)
  9. ( able character it will be displayed as 2 hex digits and 2 blanks. ) 
  10. DI
  11. : 11/100_SEC 1100 0 DO LOOP ; ( This just waits .11 sec. )
  12. HEX
  13. ( HELP prints the help menu for the HOST terminal emulator. )
  14. : HELP CR CR CR CR CR CR
  15. CR ."                  XECOM TERMINAL EMULATOR  2.00 "
  16. CR
  17. CR ."              FUNCTION       -KEY-     SHIFTED FUNCTION "
  18. CR ."           ----------------  ----- ------------------"
  19. CR
  20. CR ."                HELP SCREEN   F1    END EMULATION "
  21. CR ."          CLEAR ERROR FLAGS   F2    RUN INTERPRETER "
  22. CR ."              ECHO RECEIVER   F3    TOGGLE DTR "
  23. CR ."             SEND FUNCTIONS   F4    SEND DATA"
  24. CR ."               SET NEW MODE   F5    SET NEW CONTROL BYTE"
  25. CR ."                  STATUS ON   F6    STATUS OFF"
  26. CR ."              EXECUTE MACRO   F7    DEFINE MACRO"
  27. CR ."              LINE ANALYSIS   F8    1200 BPS ANALYSIS"
  28. CR ."            RECEIVER FORMAT   F9    CHARACTER SET TRANSMIT"
  29. CR ."            DTMF/SYNTH TEST   F10   AUTOMATIC ANSWER"
  30. CR CR CR CR ;
  31.  
  32. ( ?AUT IS TO STOP AUTO ANSWER STUFF )
  33.  : ?AUT ?TERM ABORT" AUTO ANSWER STOPPED. " ;
  34.  
  35. ( $QUERY accepts a string terminated by <CR> from the terminal and shifts )
  36. ( it one char to the right, preceding it with a '$' character, and places )
  37. ( it in the TIB which is FORTH's Terminal Input Buffer. This allows the user )
  38. ( to input a string which will be guaranteed to be unique from any other     )
  39. ( FORTH words. )
  40.  : $QUERY QUERY TIB @ DUP 1+ 4F <CMOVE 24 ( $ ) TIB @ C! ;
  41.  
  42. ( CMD! accepts a data byte and bangs it into the data port if the XR bit of )
  43. ( the status register is on, othrwise a message is printed. )
  44.  : CMD! 400 0 
  45.      DO CT@ XR AND IF DA! LEAVE THEN I 3FF = 
  46.                                 IF DROP ." NOT READY " THEN LOOP ; 
  47. ( FETCH waits for RR then fetches the status byte again and leaves a flag   )
  48. ( indicating whether DSR is on. It can be stopped by striking any key.      )
  49. CREATE CFLAG 0 ,
  50.  
  51.  : FETCH BEGIN ?KEY CT@ RR AND UNTIL CT@ DSR AND ;
  52.  : MESS DA@ DUP 42 = 
  53.           IF ."             " BLINK ."    BUSY     " NORM QUIT
  54.           ELSE DUP 56 = 
  55.             IF ."             " BLINK ."    VOICE     " NORM QUIT
  56.             ELSE DUP 44 =
  57.               IF ."             " BLINK ."    DIAL TONE    " NORM QUIT
  58.               ELSE DUP 46 =
  59.                 IF ."               " BLINK ."     CONNECTION FAILED    "
  60.                    NORM QUIT
  61.                 ELSE DUP 52 =
  62.                   IF ."             " BLINK ."     RINGING     " NORM
  63.                     CR 0 CFLAG !
  64.                   ELSE DUP 54 =
  65.                     IF ."             " BLINK ."     TIMED OUT     " NORM
  66.                         CR 0 CFLAG !
  67.                     ELSE DROP ." LAST MEASUREMENTS WERE "
  68.                     THEN
  69.                   THEN
  70.                 THEN
  71.               THEN
  72.             THEN
  73.          THEN ;
  74. ( BBLINE simply prints a blank line with sides of a box. )
  75.  : BBLINE 4 SPACES BA EMIT 40 0 DO 20 EMIT LOOP BA EMIT CR ;
  76.  
  77. CREATE STATUS 0 , ( variable indicating whether the status line is on )
  78.  
  79. : KEYZ
  80. ( EXTENDED SCREEN & KEYBOARD CONTROL : )
  81. (  FUNCTION KEYS F1 - F20 ARE ASSIGNED ASCII CODES E1 - F4 HEX)
  82. (  F11 - F20 ARE SHIFTED FUNCTION KEYS )
  83. ( F1 ) 1B EMIT ." [0;59;225p"
  84. ( F2 ) 1B EMIT ." [0;60;226p"
  85. ( F3 ) 1B EMIT ." [0;61;227p"
  86. ( F4 ) 1B EMIT ." [0;62;228p"
  87. ( F5 ) 1B EMIT ." [0;63;229p"
  88. ( F6 ) 1B EMIT ." [0;64;230p"
  89. ( F7 ) 1B EMIT ." [0;65;231p"
  90. ( F8 ) 1B EMIT ." [0;66;232p"
  91. ( F9 ) 1B EMIT ." [0;67;233p"
  92. ( F10) 1B EMIT ." [0;68;224p"
  93. ( S_F1 ) 1B EMIT ." [0;84;235p"
  94. ( S_F2 ) 1B EMIT ." [0;85;236p"
  95. ( S_F3 ) 1B EMIT ." [0;86;237p"
  96. ( S_F4 ) 1B EMIT ." [0;87;238p"
  97. ( S_F5 ) 1B EMIT ." [0;88;239p"
  98. ( S_F6 ) 1B EMIT ." [0;89;240p"
  99. ( S_F7 ) 1B EMIT ." [0;90;241p"
  100. ( S_F8 ) 1B EMIT ." [0;91;242p"
  101. ( S_F9 ) 1B EMIT ." [0;92;243p"
  102. ( S_F10) 1B EMIT ." [0;93;234p"
  103. ( CTRL/BREAK ) 1B EMIT ." [0;0;254p"
  104. ( ^C ) 1B EMIT ." [3;131p" ;
  105.  
  106. : KEYZM
  107. ( EXTENDED SCREEN & KEYBOARD CONTROL : )
  108. (  FUNCTION KEYS F1 - F20 ARE TEMPORARILY ASSIGNED ASCII CODES )
  109. (  CORRESPONDING TO f1 THRU f0 AND F1 THRU F0  ONLY DURING MACRO )
  110. (  DEFINITIONS. f means regular function keys. F means shifted func. keys.)
  111.  
  112. ( F1 ) 1B EMIT ." [0;59;102;49p"
  113. ( F2 ) 1B EMIT ." [0;60;102;50p"
  114. ( F3 ) 1B EMIT ." [0;61;102;51p"
  115. ( F4 ) 1B EMIT ." [0;62;102;52p"
  116. ( F5 ) 1B EMIT ." [0;63;102;53p"
  117. ( F6 ) 1B EMIT ." [0;64;102;54p"
  118. ( F7 ) 1B EMIT ." [0;65;102;55p"
  119. ( F8 ) 1B EMIT ." [0;66;102;56p"
  120. ( F9 ) 1B EMIT ." [0;67;102;57p"
  121. ( F10) 1B EMIT ." [0;68;102;48p"
  122. ( S_F1 ) 1B EMIT ." [0;84;70;49p"
  123. ( S_F2 ) 1B EMIT ." [0;85;70;50p"
  124. ( S_F3 ) 1B EMIT ." [0;86;70;51p"
  125. ( S_F4 ) 1B EMIT ." [0;87;70;52p"
  126. ( S_F5 ) 1B EMIT ." [0;88;70;53p"
  127. ( S_F6 ) 1B EMIT ." [0;89;70;54p"
  128. ( S_F7 ) 1B EMIT ." [0;90;70;55p"
  129. ( S_F8 ) 1B EMIT ." [0;91;70;56p"
  130. ( S_F9 ) 1B EMIT ." [0;92;70;57p"
  131. ( S_F10) 1B EMIT ." [0;93;70;48p" ;
  132.  
  133. CREATE ECHOFLAG 0 ,
  134.  
  135. ( The following words are the routines to be executed by the function keys. )
  136. ( Their functions are desribed in the help menu. )
  137.  : FK1 HELP ;
  138.  : FK2 CTL C@ ER OR CT! ;
  139.  : FK3 ECHOFLAG @ 1 XOR ECHOFLAG ! CR ECHOFLAG @ IF ." ECHO MODE ON " ELSE ." ECHO MODE OFF " THEN ; ( TOGGLE ECHO RECEIVER FLAG )
  140.  : FK4 CTL C@ [ RTS FF XOR ] LITERAL AND CTL! ; ( FUNCTION MODE )
  141.  : FK5 MODE ;
  142.  : FK6 STATUS ON ;
  143.  : FK7 ." MACRO NAME? " $QUERY -FIND IF DROP @ COMPTR ! 0
  144.      ELSE ." MACRO NOT FOUND " THEN CR ;
  145.  
  146.  : LBOX CR 4 SPACES C9 EMIT 40 0 DO CD EMIT LOOP BB EMIT CR
  147.       BBLINE 4 SPACES BA EMIT FREQ_DEV 9 SPACES BA EMIT CR
  148.       BBLINE 4 SPACES BA EMIT S/N_DB 9 SPACES BA EMIT CR
  149.       BBLINE 4 SPACES BA EMIT SIG_LEV 9 SPACES BA EMIT CR
  150.       BBLINE 4 SPACES C8 EMIT 40 0 DO CD EMIT LOOP BC EMIT CR ;
  151.  
  152. CREATE PHITS 0 , ( PHASE HITS )
  153. CREATE AVPHE 0 , ( AVERAGE PHASE ERROR )
  154.  
  155. : LBOX2 CR 4 SPACES C9 EMIT 40 0 DO CD EMIT LOOP BB EMIT CR
  156.       BBLINE 4 SPACES BA EMIT ."     AVERAGE PHASE ERROR IS " AVPHE @ 0 4 DI D.R HEX ."   DEGREES " 17 SPACES BA EMIT CR
  157.       BBLINE 4 SPACES BA EMIT ."     NUMBER OF PHASE HITS SINCE LAST MEASUREMENT IS " PHITS @ 0 4 DI D.R HEX 9 SPACES BA EMIT CR
  158.       BBLINE 4 SPACES C8 EMIT 40 0 DO CD EMIT LOOP BC EMIT CR ;
  159.  
  160.  : LDGET FETCH
  161.       IF DA@ DEV ! 
  162.       ELSE MESS EXIT
  163.       THEN FETCH 
  164.          IF DA@ LEV !
  165.          ELSE MESS EXIT
  166.          THEN FETCH
  167.             IF DA@ NN !
  168.             ELSE MESS EXIT
  169.             THEN ;
  170.  : S_F4 CTL C@ RTS OR CTL! ; ( DATA MODE )
  171.  : FK8 BEGIN FK4 1 CFLAG ! 4C CMD! 504C CIO ST1 
  172.          LDGET CFLAG @ UNTIL LBOX 
  173.          BEGIN ?KEY CT@ XR AND UNTIL S_F4 CR ." DATA MODE " ;
  174.  
  175.  : FK9 CR ." RECEIVER FORMAT (H)ex/(D)ecimal/(M)onitor/(C)haracter? "
  176.        CHARR OFF HEXR OFF DECR OFF SKEY 20 OR DUP EMIT DUP 64 =
  177.        IF DECR ON THEN DUP 68 =
  178.        IF HEXR ON THEN DUP 6D =
  179.        IF CHARR ON THEN DROP CR ;
  180. CREATE LASTKEY 0 ,
  181.  : FK10 ( VOICE/DTMF TEST )
  182.         FK4 44 XPT 16 XPT 58 XPT S_F4 ( Issue D and ^V funcs and go to data )
  183.         TRACE hello pause200 you_dialed a xecom modem 
  184.               pause200 to_exit press*key two time _s CR
  185.         BEGIN RGT DUP EMIT DUP BL EMIT 3F =
  186.          IF im_sorry ELSE DUP 23 =
  187.           IF u press#key ELSE DUP 2A =
  188.            IF u press*key LASTKEY @ 2A = IF goodbye 05 CTL ! 05 CT! QUIT THEN 
  189.            ELSE DUP DUP 30 < SWAP 39 > OR
  190.             IF ." BAD DIGIT RECEIVED:  " DUP .
  191.             ELSE 30 - 2 * UNITS + @ you_dialed CFA EXECUTE
  192.             THEN
  193.            THEN
  194.           THEN
  195.          THEN DUP LASTKEY ! DROP CR
  196.          AGAIN ;
  197.  : S_F1 ." RETURN TO SYSTEM. ARE YOU SURE ? Y/N" CR 
  198.     QUERY TIB @ C@ 20 OR 79 = IF BYE THEN CR ;
  199.  : S_F2 1 INTERP ! ." INTERPRETER ! "
  200.    BEGIN CR ST1 RP! QUERY INTERPRET STATE @ NOT IF ." OK" THEN AGAIN ;
  201.  : S_F3 CTL C@ DTR XOR CTL! ; ( TOGGLE DTR )
  202.  : S_F5 CR ST1 CTRL ;
  203.  : S_F6 STATUS OFF ;
  204.  : S_F7 KEYZM ." MACRO DEFINITION=" QUERY BL WORD DUP DUP C@ 1+ + 0
  205.    SWAP C! DUP C@ 2+ ALLOT CR
  206.    KEYZ ." MACRO NAME=" $QUERY 1+ CONSTANT ." OK " CR ;
  207.  : S_F8 FK4 1 CFLAG ! 6C CMD! 506C CIO ST1 FETCH
  208.             IF DA@ 5A * 100 / AVPHE ! 
  209.             ELSE 0 CFLAG ! DA@ 49 = IF ." INAPPROPRIATE: NO 1200 bps CONNECTION "
  210.                           ELSE ." ??? "
  211.                           THEN 
  212.             THEN FETCH
  213.                  IF DA@ PHITS !
  214.                  ELSE 0 CFLAG ! DA@ 49 = IF ." INAPPROPRIATE "
  215.                                          ELSE ." ??? "
  216.                                          THEN
  217.                  THEN CFLAG @ 
  218.                       IF LBOX2 THEN ;
  219.  : S_F9 CR ." Transmitting character-set.  Hit any key to stop." CR CSET ;
  220.  
  221. CREATE INFA 0 ,     ( INFORMATION BYTE FROM ^A )
  222.  
  223. : XWT2 BEGIN ?AUT RCV CT@ XR AND UNTIL ;
  224.  
  225.  : S_F10 CR ." WAITING FOR RING " CR 
  226.       0 INFA !
  227.       BEGIN ST1 ?AUT CT@ DET AND UNTIL 
  228.          ." RINGING DETECTED " CR FK4 01 XWT2 DA!
  229.                BEGIN ST1 ?AUT CT@ XR AND UNTIL 
  230.                   CT@ DUP RR AND 
  231.                      IF DSR AND 0=
  232.                          IF DA@ INFA !
  233.                          THEN DROP INFA @ DUP 31 = SWAP DUP 40 = OR
  234.                            IF ." DTMF " FK10
  235.                            ELSE DUP 76 = 
  236.                              IF ." VOICE " 44 XPT 16 XPT 58 XPT S_F4 QUIT
  237.      ( if voice heard DTMF rcv, voice to line, audio out, data mode ) 
  238.                              ELSE DUP 46 = 
  239.                                 IF ." FAILED " QUIT
  240.                                 ELSE DUP 49 =
  241.                                   IF ." INAPPROPRIATE " QUIT
  242.                                   ELSE DUP 54 = 
  243.                                     IF ." TIMED OUT " QUIT
  244.                                     THEN DROP
  245.                                   THEN
  246.                                 THEN
  247.                              THEN
  248.                            THEN
  249.                      ELSE ." CONNECTED -- DATA MODE " S_F4 QUIT
  250.                      THEN ;
  251.  
  252.  : VCALCU FK4 44 XPT 16 XPT S_F4 ( Issue D and ^V functions and goto data )
  253.          VCALC ;
  254.  : C_BR ( CONTROL/BREAK ) 2A EMIT 2A EMIT
  255.   BEGIN ?KEY CT@ XE AND UNTIL 
  256.      CTL @ SBR OR CTL! 11/100_SEC CTL @ [ SBR FF XOR ]
  257.      LITERAL AND CTL! ;
  258. : NOOP ;
  259. CTAG 
  260. ( The following array is the addresses of the various function key functions )
  261. ( If a function key is hit when the HOST program is running, its function    )
  262. ( address is placed in the variable COMPTR.                                  )
  263.  CREATE CODARAY ' FK10 CFA , ' FK1 CFA ,  ' FK2 CFA ,   ' FK3 CFA ,
  264.                 ' FK4 CFA ,  ' FK5 CFA ,  ' FK6 CFA ,   ' FK7 CFA ,
  265.                 ' FK8 CFA ,  ' FK9 CFA ,  ' S_F10 CFA , ' S_F1 CFA ,
  266.                 ' S_F2 CFA , ' S_F3 CFA , ' S_F4 CFA ,  ' S_F5 CFA ,
  267.                 ' S_F6 CFA , ' S_F7 CFA , ' S_F8 CFA ,  ' S_F9 CFA ,
  268.                 ' NOOP CFA , ' NOOP CFA , ' NOOP CFA ,  ' NOOP CFA ,
  269.                 ' NOOP CFA , ' NOOP CFA , ' NOOP CFA ,  ' NOOP CFA ,
  270.                 ' NOOP CFA , ' NOOP CFA , ' C_BR CFA ,  ' NOOP CFA ,
  271.  
  272. CREATE STS 0 ,   ( variable in which to save status )
  273.  
  274. : XPUT BEGIN CT@ XR AND UNTIL DA! ;
  275.  
  276.  
  277. ( Now begins the HOST routine. It does some initialization. It has a read )
  278. ( side and a write side. )
  279.  
  280. ( HOST first checks for Xecom board and aborts FORTH if it's not present  )
  281. ( HOST reassigns the function keys then gets the 1st byte of the screen   )
  282. ( memory, inverts it, stores it back, reads it again, and compares it to  )
  283. ( the original value. If it is the same, the SCRS variable remains B000   )
  284. ( which is the monochrome display segment. If it is different, then SCRS  )
  285. ( is changed to B800, the color display segment. The CRT STATUS port or   )
  286. ( CRTSTAT may also be changed to 3DA which is correct for the color card. )
  287. ( Then the STATUS variable is turned ON. And lastly, for initialization,  )
  288. ( the variable FHNDL, which is the value of the XE12xx's file handle, is  )
  289. ( checked. If it's 0, then XE1, which is the name given the XE12xx device, )
  290. ( is opened for reading and writing. Then the variable INTERP is zeroed   )
  291. ( to indicate that you are not in the interpreter and ST1 is called to    )
  292. ( place the correct status line at the top of the screen. Then the main   )
  293. ( loop of HOST read/write begins. )
  294.  
  295. : HOST COM0 COMPTR ! KEYZ B000 0 @L -1 XOR DUP B000 0 !L B000 0 @L - 
  296.     IF 3DA CRTSTAT ! B800 SCRS ! 
  297.     ELSE 3BA CRTSTAT ! B000 SCRS ! 
  298.     THEN
  299.     CR STATUS ON
  300.    FHNDL @ IF ELSE XO CT@ FF = IF ."                           "
  301.      BLINK ."     XECOM BOARD MISSING     " NORM S_F2 THEN THEN
  302.      0 INTERP ! ST1
  303.    VOC @ ( Read the voice dictionary if not already in. )
  304.    IF ." Reading '" VDFN ZTYPE ." '" CR 0 VOC !
  305.     VDFN 0 FOPEN IOCHK
  306.     DUP VSEG 0 VLOC @ 3F00 VCALL VLOC @ - ABORT" Read Error!"
  307.     ." Read Complete." CR
  308.   THEN
  309.  
  310. ( HOST EMULATOR READ SIDE )
  311.  BEGIN STATUS @ IF ST THEN    ( each loop updates status line )
  312.        BEGIN  CT@  DUP STS ! DUP C0 AND 40 = IF CLOSS THEN ( lost carrier )
  313.           DUP RR AND  ( as long as receiver ready, receive )
  314.        WHILE DA@ OVER DSR AND ( if there is data to be read ... )
  315.           IF ECHOFLAG @ IF DUP XPUT THEN 
  316.              CHARR @          ( it is output to the screen in its ... )
  317.              IF ECHAR         ( correct format )
  318.              ELSE HEXR @ 
  319.                 IF E2HD
  320.                 ELSE DECR @ 
  321.                    IF PUTD
  322.                    ELSE PUTC
  323.                    THEN
  324.                 THEN
  325.              THEN 
  326.           ELSE 7000 + CIO  COM0 COMPTR !  ( if DSR was off then the data ... )
  327.           THEN DROP           ( is an information byte returning, so COMPTR  )
  328.       REPEAT                  ( is given a ptr to 0. )
  329.     DUP XR AND 
  330.        IF 5020                ( If XR is off a funny blank char ... )
  331.        ELSE 7020              ( if XR is on a reverse video blank ... )
  332.        THEN IO"XR ! DROP      ( is put at the end of the status line. )
  333.  
  334.         ( Then the status byte is dropped and HOST write side begins. )
  335.  
  336. ( HOST EMULATOR WRITE SIDE )
  337.        ?TERM ?DUP              ( ?TERM gets one character from the terminal )
  338.           IF COM0 COMPTR !     ( If a key was hit, 0 the command string ptr )
  339.           ELSE COMPTR @ C@ DUP ( If not get the next command character )
  340.              IF 1 COMPTR +!      ( Update pointer )
  341.              DUP 46 =                      ( Is it F )
  342.                 IF DROP COMPTR @ C@ 1 COMPTR +! BA + ( Convert to FUNCTION )
  343.                 ELSE DUP 66 =                       ( Is it f )
  344.                   IF DROP COMPTR @ C@ 1 COMPTR +! B0 + ( Convert to function )
  345.                   ELSE STS @ XR AND
  346.                      IF                       ( If ready take any character )
  347.                      ELSE -1 COMPTR +! DROP 0 ( Back up and leave a zero )
  348.                      THEN
  349.                   THEN
  350.                THEN
  351.              THEN
  352.            THEN DUP 3 =        ( was it a control/break ? )
  353.              IF C_BR
  354.              THEN DUP DF >    ( was it a function key ? )
  355.           IF E0 - 2* CODARAY + @ EXECUTE    ( if so, look up routine )
  356.           ELSE ?DUP 
  357.              IF STS @ XR AND    ( if there is a char and XR is on ... )
  358.                 IF CTL C@ RTS AND 0=  ( fetch the shadow, if RTS is off... )
  359.                    IF DUP 0700 + CIO ( put it on the command line )
  360.                    ELSE HALFDUP @  ( if not, check half duplex )
  361.                       IF DUP EMIT  ( if on, emit character on screen )
  362.                       THEN 
  363.                    THEN DA!        ( finally send datum to data port )
  364.                 ELSE B0 EMIT DROP  ( if transmitter wasn't ready emit B0 )
  365.                 THEN               ( B0 is a fuzzy block character . )
  366.              THEN 
  367.           THEN
  368.       AGAIN ;
  369. CTAG 
  370.  
  371.  
  372. : VDEMO S_F4 congratulations on your xecom modem purchase ;
  373.  
  374. HEX
  375. : QPATCH ' HOST CFA 1E2F ! ;
  376. : UNQPATCH ' QUERY CFA 1E2F ! ;
  377.  
  378. ASSEMBLER DEFINITIONS 
  379.     HEX CD 1A 10MI INT1A
  380. FORTH DEFINITIONS
  381.  
  382. CODE GETIME AH, # 0000 MOV INT1A DX PUSH CX PUSH NEXT JMP END-CODE
  383. CODE SETIME AH, # 0001 MOV INT1A DX, # 0000 MOV CX, # 0000 MOV
  384.         INT1A NEXT JMP END-CODE
  385.  
  386. CREATE CHR 0 , CREATE ERC 0 , CREATE CHRS 0 , ( CHARS SENT )
  387. CREATE THOWS 0 , CREATE MINUTES 0 ,
  388. CREATE TIMHI 0 , CREATE TIMLO 0 ,
  389. CREATE TCNTR 0 ,
  390.  
  391. : TIMCMP -1 TCNTR +! TCNTR @  0= IF  64 TCNTR ! TIMLO @ TIMHI @ 
  392.     GETIME D- DABS 4.44 D>
  393.     IF 1 MINUTES +! CR
  394.     DI MINUTES @ . ." MINUTE(S) " THOWS @ 3E8 M* CHRS @ 0 D+ 
  395.     D. ." CHARACTERS SENT "
  396.     ERC @ . ." ERRORS " CR HEX GETIME TIMHI ! TIMLO ! THEN THEN ;
  397.    
  398. : CHRADJ 1 CHR +! CHR @ 7B = IF 2C CHR ! THEN ;
  399. : RGT1 CT@ RR AND IF DA@ TIMCMP CHRADJ DUP CHR @ = NOT IF 1 ERC +! DUP EMIT CHR @ EMIT BL EMIT THEN CHR ! THEN ;
  400. : XWT1 BEGIN ?KEY RGT1 CT@ XR AND UNTIL ;
  401. : XPT1 XWT1 DA! 1 CHRS +! CHRS @ 3E8 = IF 0 CHRS ! 1 THOWS +! THEN ;
  402. : CSX1 7B 2C DO I XPT1 LOOP ;
  403. : CSET1 GETIME TIMHI ! TIMLO ! 1B XPT1 2A XPT1 64 TCNTR ! 2B CHR ! 0 MINUTES ! 0 CHRS ! 0 THOWS ! 
  404.     0 ERC ! 0  BEGIN CSX1 ?TERM UNTIL ;
  405.  
  406. CREATE DDOC 0 , 0 , 
  407. CREATE WDOC 0 , 0 , 
  408.  
  409. : PLANT -FIND IF DROP D@ WDOC D! ELSE ." OOPS " THEN ;
  410. : DOC OVER + WDOC @ SWAP - DDOC ! WDOC 2+ @ + DDOC 2+ ! DDOC SAY ;
  411. : SDOC CREATE DDOC @ , DDOC 2+ @ , DOES> 'SAY @ EXECUTE ;
  412.  
  413.